Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostu2/floor2.pas

Pascal/Delphi Source File | 1994-12-01 | 8.3 KB | 387 lines

PROGRAM floor2;
{
  Floor of Doom, second life
  - by Bjarke Viksφe
  oct 1994

  Use mouse and mousebuttons!
  Trying to rotate the damn thing. (Jazz JackRabbit, here I come :)
  Anyway, rotating a texturemapped floor is hardly a demo thing -
  but a game idea? And very tricky to do.

  Ok, it's pretty much the same as "Floor1" except that I do both a x-slope
  and a y-slope run.
  And all rotated coords are precalc'ed (LINES*2 coords per angle). Only
  half of the 512 angles are actually precalc'ed, the other half is
  calc'ed using the others (by negating x/y).
  Oh, it needs about 320 Kb of free memory! Quit the IDE and start it
  from the prompt on machines which are low on memory...
}

{$A+,B-,G+,E+,I+,N-,X+}
{$IFDEF DPMI}
{$C FIXED PRELOAD PERMANENT}
{$ENDIF}

USES
    DEMOINIT,MOUSE;

{{$DEFINE DEBUG}

TYPE
    pBunk = ^BunkArray;
    BunkArray = ARRAY[0..254, 0..255] of byte;
    pIntegerArray = ^IntegerArray;
    IntegerArray = ARRAY[0..32760] of integer;

CONST
    LINES = 70; {how many lines shall we paint}
    TILT = 31780; {tilt floor how much?}

VAR
    map, tiles : pBunk;
    LineTable : array[1..3] of pIntegerArray;
    xpos,ypos, angle : word;
    CoordPtr : array[0..255] of pointer;
    SinusTable  : array[0..639] of integer;


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        SinusTable[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetColours;
{Setup ugly, more or less randomly picked, colours}
var
    i : integer;
begin
    for i:=0 to 7 do setRGB(i, i,i,i);
    for i:=8 to 15 do setRGB(i, (i-5)*2,0,0);
    for i:=16 to 23 do setRGB(i, 0,(i-10)*2,(i-8)*2);
    for i:=24 to 31 do setRGB(i, 0,0,42);
    for i:=32 to 39 do setRGB(i, 0,(i-15)*2,0);
    for i:=40 to 47 do setRGB(i, i,i,i);
    for i:=48 to 55 do setRGB(i, i,0,0);
end;


procedure CreateMap;
{Create map.
 Characters in string are indexes to tiles! 'a' is tile #0,
 'b' is #1 (red one) and so...}
 procedure Strip(ypos,xpos : integer; st : string);
 var j : integer;
 begin
        for j:=1 to length(st) do st[j]:=char(ord(st[j])-ord('a'));
        Move(st[1],map^[ypos,xpos],length(st));
 end;
var
    y : integer;
begin
    GetMem(map,65535);
    FillChar(map^,65535,#0);

    y:=20;
    while y<60 do begin
        Strip(y,30,'fgfgfgfgfgfgfgfgfgfg');
        Strip(y+1,30,'gfgfgfgfgfgfgfgfgfgf');
        if (y>35) AND (y<45) then begin Strip(y,39,'aaaaa'); Strip(y+1,39,'aaaaa'); end;
        inc(y,2);
    end;
    Strip(20,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc'); Strip(21,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
    y:=22;
    while (y<42) do begin
        Strip(y,70,'bcaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabc'); Strip(y+1,70,'cbaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaacb');
        Strip(y,60,'dedede'); Strip(y+1,60,'ededed');
        inc(y,2)
    end;
    Strip(42,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc');
    Strip(43,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
end;

procedure CreateTiles;
{Create some ugly tiles. We simple choose some colours and paint
 a brick with them}
var
    i,j : integer;
begin
    GetMem(tiles,65535);
    FillChar(tiles^,65535,#0);

    for i:=0 to 254 do {254, not 255, to get in running under DPMI!}
        for j:=0 to 255 do
            tiles^[i,j]:=((j DIV 32)*8) + random(8); {make dithered tile}
end;


procedure PrecalcLines;
const
    XPOS = 20; {this will ajust the height of the viewer}
var
    q,p,i, x1,y1,x2,y2 : integer;
    z,sin1,cos1 : integer;
    pos,angle : word;
    cx,cy : longint;
begin
    for i:=1 to 3 do GetMem(LineTable[i],65535);

    p:=1;
    pos:=0;
    angle:=0;
    for q:=0 to 255 do begin
        CoordPtr[q]:=@LineTable[p]^[pos];

        z:=8000;
        sin1:=SinusTable[angle];
        cos1:=SinusTable[angle+128];
        for i:=1 to LINES do begin
            x1:=LongDiv(-XPOS*65536,z); {calc first coord}
            y1:=LongDiv((LINES-i)*longint(TILT),z);
            cx := (LongMul(x1,cos1) - LongMul(y1,sin1)) DIV 32768; {rotate it}
            cy := (LongMul(x1,sin1) + LongMul(y1,cos1)) DIV 32768;
            x1:=cx;
            y1:=cy;
            LineTable[p]^[pos]:=x1;
            LineTable[p]^[pos+1]:=y1;

            x2:=LongDiv(XPOS*65535,z); {calc second coord}
            y2:=LongDiv((LINES-i)*longint(TILT),z);
            cx := (LongMul(x2,cos1) - LongMul(y2,sin1)) DIV 32768; {rotate it}
            cy := (LongMul(x2,sin1) + LongMul(y2,cos1)) DIV 32768;
            x2:=cx;
            y2:=cy;
            LineTable[p]^[pos+2]:=(longint(x2-x1) SHL 11) DIV 160;
            LineTable[p]^[pos+3]:=(longint(y2-y1) SHL 11) DIV 160;
            inc(pos,4);

            inc(z,310);
        end;

        {Check if next set of coords should be placed in other buffer, since
         they cannot all fit into one 64Kb segment!!!}
        if ((pos*2 + (LINES*8)) > 65200) then begin
            inc(p);
            pos:=0;
        end;
        inc(angle,1); {calc next angle}
    end;
end;



procedure InitDemo;
var
    i : integer;
begin
    ClearWholeScreen;
    SetColours;
    SetupSinus;

    CreateMap;
    CreateTiles;
    PrecalcLines;

    xpos:=1200; ypos:=800;
    angle:=0;
end;

procedure UninitDemo;
var
    i : integer;
begin
    FreeMem(map,65535);
    FreeMem(tiles,65535);
    for i:=1 to 3 do FreeMem(LineTable[i],65535);
end;


(*------------------------------------------------*)

procedure MoveHero;
var
    x,y, sin1,cos1 : integer;
    cx,cy : longint;
begin
    {Determine new rotation angle}
    ReadMouseMotionCounters(x,y);
    angle:=(angle + x) AND 511;

    {is hero moving forward?}
    if (LeftButton) then begin
        sin1:=SinusTable[angle];
        cos1:=SinusTable[angle+128];
        x:=0;  {this is the moving speed}
        y:=6;
        cx := (longmul(x,cos1) - longmul(y,sin1)) DIV 32768;
        cy := (longmul(x,sin1) + longmul(y,cos1)) DIV 32768;
        inc(xpos,cx);
        inc(ypos,cy);
    end;

    {hero cannot move outside board}
    if (xpos<200) then xpos:=200;
    if (xpos>16384) then xpos:=16384;
    if (ypos<200) then ypos:=200;
    if (ypos>16384) then ypos:=16384;
end;

(*------------------------------------------------*)

procedure DrawFloor(x,y, angle : integer; Coords : pointer); assembler;
var
    mappos,tablepos : word;
    xadd,yadd,
    mapxadd,mapyadd : integer;
    height, counts : word;
asm
    push    ds
    mov    es,SEGA000
    mov    di,100*320
    mov    ax,WORD PTR [map+2]
    {mov fs,ax} DB $8E,$E0
    mov    ax,WORD PTR [Coords+2]
    {mov gs,ax} DB $8E,$E8
    mov    ax,WORD PTR [Coords]
    mov    [tablepos],ax
    mov    ds,WORD PTR [tiles+2]

    cld
    mov    [height],LINES
@y_run:

    mov    si,[tablepos]

    DB GS; mov    ax,[si+4]
    cmp    [angle],256
    jb        @anglelow1
    neg    ax
@anglelow1:
    mov    [xadd],ax
    mov    [mapxadd],1
    or        ax,ax
    jns    @mapxup
    mov    [mapxadd],-1
@mapxup:

    DB GS; mov    ax,[si+6]
    cmp    [angle],256
    jb        @anglelow2
    neg    ax
@anglelow2:
    mov    [yadd],ax
    mov    [mapyadd],256
    or        ax,ax
    jns    @mapyup
    mov    [mapyadd],-256
@mapyup:

    DB GS; mov    dx,[si]
    DB GS; mov    cx,[si+2]
    cmp    [angle],256
    jb        @anglelow3
    neg    cx
    neg    dx
@anglelow3:
    add    dx,[x]
    add    cx,[y]

    mov    bx,dx                    {Find first tile}
    mov    ax,cx
    shr    ax,5
    shr    bx,5
    mov    bh,al
    mov    [mappos],bx
    DB FS; mov al,[bx]        {get tile-index from map}
    mov    ah,al                    {find map position in map-buffer}
    and    al,7
    shr    ah,3
    shl    ax,5
    mov    si,ax

    shl    dx,11
    shl    cx,11
    xor    dx,$8000
    xor    cx,$8000

    mov    [counts],160
@x_run:
    mov    bh,dh        {get x-position of pixel}
    mov    bl,ch        {get y-position of pixel}
    shr    bx,3
    and    bx,$1F1F
    mov    al,[si+bx]    {get that pixel}
    mov    ah,al
    stosw                    {store it... well, we draw it twice to gain speed!}

    add    dx,[xadd]            {add to x-slope}
    jno    @noxadd
    mov    bx,[mappos]
    add    bx,[mapxadd]
    mov    [mappos],bx
    DB FS; mov al,[bx]        {get new tile-index from map}
    mov    ah,al                    {find tile position in tile-buffer}
    and    al,7
    shr    ah,3
    shl    ax,5
    mov    si,ax
@noxadd:

    add    cx,[yadd]            {add to y-slope}
    jno    @noyadd
    mov    bx,[mappos]
    add    bx,[mapyadd]
    mov    [mappos],bx
    DB FS; mov al,[bx]        {get new tile-index from map}
    mov    ah,al                    {find tile position in tile-buffer}
    and    al,7
    shr    ah,3
    shl    ax,5
    mov    si,ax
@noyadd:

    dec    [counts]
    jnz    @x_run

    add    [tablepos],8
    dec    [height]
    jnz    @y_run

    pop    ds
end;


(*------------------------------------------------*)

procedure RunOnce;
var
    i : integer;
begin
    VBLANK;
{$IFDEF DEBUG}    SetRGB(0,20,0,0); {$ENDIF}
    MoveHero;
    DrawFloor(xpos,ypos, angle, CoordPtr[angle AND 255]);
{$IFDEF DEBUG}    SetRGB(0,0,0,0); {$ENDIF}
end;


begin
    if NOT MouseDriverPresent then begin writeln('No mouse...'); halt; end;

    SetScreenMode($13);
    InitDemo;
    repeat RunOnce until KeyPressed;
    UninitDemo;
    SetScreenMode(TEXTMODE);
end.